;; core/byte.scm - (c) rohan drape, 2002-2005

;; Decode and encode forms for network order integers and floats.

(define (decode-int8 b)    (u8vector->integer b #t #t))
(define (decode-uint8 b)   (u8vector->integer b #f #t))
(define (decode-int16 b)   (u8vector->integer b #t #t))
(define (decode-uint16 b)  (u8vector->integer b #f #t))
(define (decode-int32 b)   (u8vector->integer b #t #t))
(define (decode-uint32 b)  (u8vector->integer b #f #t))
(define (decode-int64 b)   (u8vector->integer b #t #t))
(define (decode-uint64 b)  (u8vector->integer b #f #t))
(define (decode-float32 b) (u8vector->real b #t))
(define (decode-float64 b) (u8vector->real b #t))
(define (encode-int8 n)    (integer->u8vector n 1 #t #t))
(define (encode-uint8 n)   (integer->u8vector n 1 #f #t))
(define (encode-int16 n)   (integer->u8vector n 2 #t #t))
(define (encode-uint16 n)  (integer->u8vector n 2 #f #t))
(define (encode-int32 n)   (integer->u8vector n 4 #t #t))
(define (encode-uint32 n)  (integer->u8vector n 4 #f #t))
(define (encode-int64 n)   (integer->u8vector n 8 #t #t))
(define (encode-uint64 n)  (integer->u8vector n 8 #f #t))
(define (encode-float32 n) (real->u8vector n 4 #t))
(define (encode-float64 n) (real->u8vector n 8 #t))

;; Little-endian variants.

(define (decode-int8/le b)    (u8vector->integer b #t #f))
(define (decode-uint8/le b)   (u8vector->integer b #f #f))
(define (decode-int16/le b)   (u8vector->integer b #t #f))
(define (decode-uint16/le b)  (u8vector->integer b #f #f))
(define (decode-int32/le b)   (u8vector->integer b #t #f))
(define (decode-uint32/le b)  (u8vector->integer b #f #f))
(define (decode-int64/le b)   (u8vector->integer b #t #f))
(define (decode-uint64/le b)  (u8vector->integer b #f #f))
(define (decode-float32/le b) (u8vector->real b #f))
(define (decode-float64/le b) (u8vector->real b #f))
(define (encode-int8/le n)    (integer->u8vector n 1 #t #f))
(define (encode-uint8/le n)   (integer->u8vector n 1 #f #f))
(define (encode-int16/le n)   (integer->u8vector n 2 #t #f))
(define (encode-uint16/le n)  (integer->u8vector n 2 #f #f))
(define (encode-int32/le n)   (integer->u8vector n 4 #t #f))
(define (encode-uint32/le n)  (integer->u8vector n 4 #f #f))
(define (encode-int64/le n)   (integer->u8vector n 8 #t #f))
(define (encode-uint64/le n)  (integer->u8vector n 8 #f #f))
(define (encode-float32/le n) (real->u8vector n 4 #f))
(define (encode-float64/le n) (real->u8vector n 8 #f))

;; Read and write forms for network order integers and floats.

#|
;; Generate read and write forms for a value of `type' which is of
;; fixed encoding size `size' bytes.

(define (recode-form->io-form type size)
  `((define (,(symbol-append 'read- type) port)
      (,(symbol-append 'decode- type)
       (read-u8vector ,size port)))
    (define (,(symbol-append 'write- type) n port)
      (write-u8vector (,(symbol-append 'encode- type) n) port))))

;; These functions are auto-generated...  

(pretty-print
 (append-map 
  recode-form->io-form
  '(int8 uint8 int16 uint16 int32 uint32 int64 uint64 float32 float64)
  '(1 1 2 2 3 3 4 4 4 4)))
|#

(define (read-int8 port) (decode-int8 (read-u8vector 1 port)))
(define (write-int8 n port) (write-u8vector (encode-int8 n) port))
(define (read-uint8 port) (decode-uint8 (read-u8vector 1 port)))
(define (write-uint8 n port) (write-u8vector (encode-uint8 n) port))
(define (read-int16 port) (decode-int16 (read-u8vector 2 port)))
(define (write-int16 n port) (write-u8vector (encode-int16 n) port))
(define (read-uint16 port) (decode-uint16 (read-u8vector 2 port)))
(define (write-uint16 n port) (write-u8vector (encode-uint16 n) port))
(define (read-int32 port) (decode-int32 (read-u8vector 4 port)))
(define (write-int32 n port) (write-u8vector (encode-int32 n) port))
(define (read-uint32 port) (decode-uint32 (read-u8vector 4 port)))
(define (write-uint32 n port) (write-u8vector (encode-uint32 n) port))
(define (read-int64 port) (decode-int64 (read-u8vector 8 port)))
(define (write-int64 n port) (write-u8vector (encode-int64 n) port))
(define (read-uint64 port) (decode-uint64 (read-u8vector 8 port)))
(define (write-uint64 n port) (write-u8vector (encode-uint64 n) port))
(define (read-float32 port) (decode-float32 (read-u8vector 4 port)))
(define (write-float32 n port) (write-u8vector (encode-float32 n) port))
(define (read-float64 port) (decode-float64 (read-u8vector 8 port)))
(define (write-float64 n port) (write-u8vector (encode-float64 n) port))

(define (read-int8/le port) (decode-int8/le (read-u8vector 1 port)))
(define (write-int8/le n port) (write-u8vector (encode-int8/le n) port))
(define (read-uint8/le port) (decode-uint8/le (read-u8vector 1 port)))
(define (write-uint8/le n port) (write-u8vector (encode-uint8/le n) port))
(define (read-int16/le port) (decode-int16/le (read-u8vector 2 port)))
(define (write-int16/le n port) (write-u8vector (encode-int16/le n) port))
(define (read-uint16/le port) (decode-uint16/le (read-u8vector 2 port)))
(define (write-uint16/le n port) (write-u8vector (encode-uint16/le n) port))
(define (read-int32/le port) (decode-int32/le (read-u8vector 4 port)))
(define (write-int32/le n port) (write-u8vector (encode-int32/le n) port))
(define (read-uint32/le port) (decode-uint32/le (read-u8vector 4 port)))
(define (write-uint32/le n port) (write-u8vector (encode-uint32/le n) port))
(define (read-int64/le port) (decode-int64/le (read-u8vector 8 port)))
(define (write-int64/le n port) (write-u8vector (encode-int64/le n) port))
(define (read-uint64/le port) (decode-uint64/le (read-u8vector 8 port)))
(define (write-uint64/le n port) (write-u8vector (encode-uint64/le n) port))
(define (read-float32/le port) (decode-float32/le (read-u8vector 4 port)))
(define (write-float32/le n port) (write-u8vector (encode-float32/le n) port))
(define (read-float64/le port) (decode-float64/le (read-u8vector 8 port)))
(define (write-float64/le n port) (write-u8vector (encode-float64/le n) port))

;; Aliases

(define decode-i8 decode-int8)
(define decode-u8 decode-uint8)
(define decode-i16 decode-int16)
(define decode-u16 decode-uint16)
(define decode-i32 decode-int32)
(define decode-u32 decode-uint32)
(define decode-i64 decode-int64)
(define decode-u64 decode-uint64)
(define decode-f32 decode-float32)
(define decode-f64 decode-float64)

(define read-i8 read-int8)
(define read-u8 read-uint8)
(define read-i16 read-int16)
(define read-u16 read-uint16)
(define read-i32 read-int32)
(define read-u32 read-uint32)
(define read-i64 read-int64)
(define read-u64 read-uint64)
(define read-f32 read-float32)
(define read-f64 read-float64)

(define encode-i8 encode-int8)
(define encode-u8 encode-uint8)
(define encode-i16 encode-int16)
(define encode-u16 encode-uint16)
(define encode-i32 encode-int32)
(define encode-u32 encode-uint32)
(define encode-i64 encode-int64)
(define encode-u64 encode-uint64)
(define encode-f32 encode-float32)
(define encode-f64 encode-float64)

(define write-i8 write-int8)
(define write-u8 write-uint8)
(define write-i16 write-int16)
(define write-u16 write-uint16)
(define write-i32 write-int32)
(define write-u32 write-uint32)
(define write-i64 write-int64)
(define write-u64 write-uint64)
(define write-f32 write-float32)
(define write-f64 write-float64)

;; Convert a list of integer byte values in the order most significant
;; byte first into an integer.

(define (byte-list->integer bytes)
  (let loop ((shift (* (- (length bytes) 1) 8))
	     (data bytes)
	     (result 0))
    (if (null? data)
	result
	(loop (- shift 8) 
	      (cdr data) 
	      (+ result (arithmetic-shift (car data) shift))))))

;; Return the list of `n' bytes, most significant first, that
;; represent `integer'.

(define (integer->byte-list integer n)
  (let loop ((byte (- n 1))
	     (result '()))
    (if (negative? byte)
	(reverse result)
	(loop (- byte 1)
	      (cons (bitwise-and (- (expt 2 8) 1)
				 (arithmetic-shift integer (* byte -8)))
		    result)))))
